Collection of Tools & Utilities/Collection of Tools and Utilities.iso/basic/qbtree55.zip/XBTREE2.BAS

BASIC Source File | 1991-07-31 | 14KB | 410 lines

DECLARE SUB MoveIn (rec$, vseg%, voff%)
DECLARE FUNCTION MoveOut$ (vseg%, voff%, bytes%)
DECLARE FUNCTION Prepare$ (vseg%, voff%, bytes%)
DECLARE FUNCTION OpenXAppFiles% ()
DECLARE FUNCTION BuildXAppFiles% ()
DECLARE FUNCTION ShowXAppFiles% ()
DECLARE FUNCTION CreateXAppFiles% ()

DEFINT A-Z
REM $INCLUDE: 'qbtree.bi'

'XBTREE2.BAS - an example application that exercises QBTree.
'(C)1991 Cornel Huth
'31-Jul-1991
'
'------------------------------- DESCRIPTION --------------------------------
'
' A) Primary key in EMP.DAT is EMP#. For each employee there is one and only
' one EMP# and for each EMP# there is one and only one employee. Each
' employee is assigned to a department. EMP.DAT:DEPT#, the foreign key,
' contains the department number he is assigned to.
'
' Given an employee number (in EMP.DAT) you can find which department he is
' assigned. You can also find the name of his manager.
'
'
' B) Primary key in DEP.DAT is DEPT#. For each department there is one and
' only one DEPT# and for each DEPT# there is one and only one department.
' DEP.DAT:MGR#, the foreign key, contains the employee number of that
' department's manager.
'
' Given a department number (in DEP.DAT) you can find the name of the
' manager of that department.
'
'
' C) Primary key in DEPEMP.DAT is DEP#+EMP#. Since each DEP# is unique and
' each EMP# is unique, combining the two you get a unique key. The DEP#
' portion of the key groups all EMP#'s in DEP# together allowing you to get
' all EMP#'s in a particular DEP#.
'
' Given a department number (in DEPEMP.DAT) you can find all employees in
' that department. To get a unique primary key, the employee number is
' combined with the department number. With QBTREE you can specify a
' partial key (in this case just DEPT# with an EMP# of 0) and QBTREE will
' return the first DEPT#+EMP#. Using GetNext() you continue processing
' this until the DEPT# portion changes.
'
'
'  ====  Primary key (field used to index this file)
'
'  ----  Foreign key (field used to connect to another file's primary key)
'
'  ≡≡≡≡  Used as both primary and foreign key
'
'                                               C) DEPEMP.DAT RECORD*
'                                                  ┌───────┬──────┐
'   ┌────────────────────────────────────┐         │ DEPT# │ EMP# │
'   │                                    │         │ ===== │ ≡≡≡≡ │
'     A) EMP.DAT RECORD                 │         └───────┴──────┘
'┌──────┬───────────────┬────────┬────┐  └────────────────────┘
'│ EMP# │ EMPLOYEE NAME │ DEPT#  │ WG │
'│ ==== │               │ -----  │    │     B) DEP.DAT RECORD
'└──────┴───────────────┴────────┴────┘   ┌───────┬───────────┬──────┐
'                          │             │ DEPT# │ DEPT NAME │ MGR# │
'   │                       └─────────── │ ====  │           │ ---- │
'   │                                     └───────┴───────────┴──────┘
'   │                                                            │
'   └────────────────────────────────────────────────────────────┘
'
' Example datafile contents:
'
'            EMP.DAT                  DEP.DAT        DEPEMP.DAT*
'  EMP# EMPLOYEE NAME   D# WG    D# DEPT NAME  MGR#    D# EMP#
'  ---- --------------- -- --    -- ---------- ----    -- ----
'  1001 Frank Haas      12 15    10 Purchasing 1002    10 1002
'  1002 Wendy Gibson    10 15    11 Accounting 2173    11 2173
'  1125 Willie McAffee  14  9    12 Legal      1001    12 1001
'  1507 David Robinson  13  9    13 MIS        1507    13 1507
'  2173 Jackie Stewart  11 17    14 Personnel  1125    14 1125
'  ... and so on                 ... and so on         ... and so on
'
' * DEPEMP.DAT carries no information other than the DEP# in DEP.DAT
' and the EMP# in EMP.DAT. This means we do not need to carry a data
' file for the DEPEMP information. What is listed in this description
' as DEPEMP.DAT will actually be the index file itself (DEPEMP.NDX).
'----------------------------------------------------------------------------
'
' This program will output to the screen two logical tables. Table 1, the
' BY EMPLOYEE table, will have the employee's number, name, wage grade,
' department, and manager. Table 2, the BY DEPARTMENT table, will have a list of
' employees in each department.
'
'============================================================================

' QBTREE file number equates
CONST EMPdf = 0         'EMP.DAT QBTREE data file number
CONST DEPdf = 1         'DEP.DAT
CONST MDF = 1           'max data files needed (last data file number)

CONST EMPif = 0         'EMP.NDX QBTREE index file number
CONST DEPif = 1         'DEP.NDX
CONST DEPEMPif = 2      'DEPEMP.NDX
CONST MKF = 2           'max key files needed (last key file number)

CONST ASMODE = 2        'files opened in compatiblity mode

' Employee data record type
TYPE EmpDataTYPE
Number AS STRING * 4
zName AS STRING * 15
DeptNo AS STRING * 2
WG AS INTEGER
END TYPE '23
DIM SHARED EMP AS EmpDataTYPE

' Department data record type
TYPE DepDataTYPE
Number AS STRING * 2
zName AS STRING * 10
MgrNo AS STRING * 4
END TYPE '16
DIM SHARED DEP AS DepDataTYPE

'size FixedStr to largest TYPE structure used in QBTREE access
DIM SHARED FixedStr AS STRING * 23

DIM SHARED XEmpData$
DIM SHARED XDepData$
DIM SHARED XEmpIndex$
DIM SHARED XDepIndex$
DIM SHARED XDepEmpIndex$

' We'll create 3 key files and 2 data files using the info from the
' DATA statements below. Once built we'll show two tables based on the data

CLS
stat = InitQBTREE(MKF, MDF)
IF stat = 0 THEN
   stat = CreateXAppFiles
   IF stat = 0 THEN
      stat = OpenXAppFiles
      IF stat = 0 THEN
         stat = BuildXAppFiles
         IF stat = 0 THEN
            stat = ShowXAppFiles
            IF stat THEN
               PRINT "Error"; stat; "from ShowXAppFiles"
            END IF
         ELSE
            PRINT "Error"; stat; "from BuildXAppFiles"
         END IF
      ELSE
         PRINT "Error"; stat; "from OpenXAppFiles"
      END IF
   ELSE
      PRINT "Error"; stat; "from CreateXAppFiles"
   END IF
ELSE
   PRINT "Error"; stat; "from InitQBTREE"
END IF
nul = ExitQBTREE
END


' We'll use DATA statements to simplify getting the initial data

' XApp employee data
EmpData:
DATA 11
DATA 1001,Frank Hass,12,15
DATA 1002,Wendy Gibson,10,15
DATA 1125,Willie McAffee,14,9
DATA 1507,David Robinson,13,9
DATA 1173,Jackie Stewart,11,17
DATA 4105,Beatrice South,10,5
DATA 4288,Jim Davies,10,5
DATA 4901,Tom Cassidy,14,4
DATA 3149,Nancy Cannon,13,7
DATA 3510,John Madison,12,12
DATA 3685,Chris Ho,13,9

' XApp department data
DepData:
DATA 5
DATA 10,Purchasing,1002
DATA 11,Accounting,1173
DATA 12,Legal,1001
DATA 13,MIS,1507
DATA 14,Personnel,1125

FUNCTION BuildXAppFiles

'using the info in the DATA statements build the XApp files

PRINT "Building employee data and index files...";
RESTORE EmpData
READ EmpRecs
FOR i = 1 TO EmpRecs
   READ EMP.Number, EMP.zName, EMP.DeptNo, EMP.WG
   key$ = EMP.Number
   rec$ = MoveOut$(VARSEG(EMP), VARPTR(EMP), LEN(EMP))
   stat = AddKeyRecord(EMPif, EMPdf, key$, rec$)
   IF stat THEN EXIT FOR
NEXT
IF stat = 0 THEN
   PRINT "ok."
   PRINT "Building department data and index files...";
   RESTORE DepData
   READ DepRecs
   FOR i = 1 TO DepRecs
      READ DEP.Number, DEP.zName, DEP.MgrNo
      key$ = DEP.Number
      rec$ = MoveOut$(VARSEG(DEP), VARPTR(DEP), LEN(DEP))
      stat = AddKeyRecord(DEPif, DEPdf, key$, rec$)
      IF stat THEN EXIT FOR
   NEXT
   IF stat = 0 THEN
      PRINT "ok."
      PRINT "Building department+employee index file...";

      ' to build this index file we use the employee file just built.
      ' a shortcoming of this is that departments with no employees
      ' (unlikely) assigned will not be represented in the index file.

      recno& = 0 'we won't be needing data record pointers for StoreKey()

      stat = GetFirst(EMPif, EMPdf, key$, rec$)
      DO WHILE stat = 0

         'r